home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / prtcs155.zip / EMP.WPL < prev    next >
Text File  |  1994-01-14  |  5KB  |  195 lines
  1. /**/
  2. v="$VER: EMP Wplrx  Empire Environment Process       Williamson 51.02"
  3. epath    = "OS3:games/EMP2/Progs/"
  4. gpath    = "OS3:games/EMP2/Game/"
  5. empfile.1= "FILE:ADSCOMM/EMPFE.LHA"
  6. empdesc.1= '  1   -   Information text in Amiga Empire'
  7. empfile.2= "FILE:ADSCOMM/EMPHELP.LHA"
  8. empdesc.2= '  2   -   Empire Graphic Terminal Program'
  9. empfile.3= "FILE:ADSCOMM/EMPDOCPP.LHA"
  10. empdesc.3= '  3   -   PowerPacked Empire Player Documentation'
  11. empfile.4= "INFO:EMPIRE.TEXT"
  12. empdesc.4= '  4   -   Empire Online Help files'
  13. empfiles = 4
  14.  
  15. trace background  
  16. options results
  17. options failat 20
  18. signal on syntax  
  19. signal on halt
  20. signal on ioerr
  21. signal on break_c
  22. signal on break_d
  23.  
  24. if ~show("L", "rexxsupport.library") then
  25.     if ~addlib("rexxsupport.library", 0, -30, 0) then exit 20
  26. log=show('P','ROOFLOG')
  27.  
  28. script  = 'EmpireWPL'
  29. rpath   = addslash(dequote(GetClip('REXXDIR')))
  30.  
  31.  
  32. mailer=GetCLip('SHELTER')
  33. l_mailer=lower(mailer)
  34. quote='"'
  35. cr= '\r\n'
  36. Pragma('D',gpath)
  37. setstack="stack 30000"||'0a'x
  38.  
  39. parse arg baud line username
  40. if username="" then username = 'Unknown User'
  41. resp=prompt(60,cr||' 'username', Would you like to download Amiga Empire Players Files? y/N: ')
  42. if upper(resp) = 'Y' then call req
  43.  
  44. resp=prompt(60,cr||' 'username', Do you wish to play empire now? Y/n: ')
  45. if upper(resp) = 'N' then do
  46.     call send(cr||'Returning to Login:'||cr)
  47.     call cleanup
  48.     exit 0
  49. end
  50. if ~show('P','Empire port') then do
  51.     call send(cr||'Launching Empire server, please wait'||cr)
  52.     PutLog('Loading Empire Server',10,10)
  53.     com=setstack||'Run' gpath'EmpServ'
  54.     address COMMAND com
  55.  
  56.     do i = 1 to 900
  57.         if ~showlist('p','Empire port') then do
  58.             call send('.')
  59.             call delay 10
  60.         end;else leave i
  61.     end
  62.     
  63.     if ~showlist('p','Empire port') then do
  64.         call send(cr||'Sorry, system resources under heavy load, try again later'||cr)
  65.         PutLog('Empire port did not open fast enough',10,10)
  66.         exit
  67.     end
  68. end
  69.  
  70. call send(cr||' Loading SerEMP'||cr)
  71. call send(cr||' Type 'creationpassword' when creating a new country and then your')
  72. call send(cr||' own private country password when asked.')
  73.  
  74. 'String $(device) $(unit)'
  75. x=RESULT;device=word(x,1);unit=word(x,2)
  76. Call PutLog('Launching SerEmpire @ 'baud' bps on line' line 'device:'device' unit:'unit,10,10)
  77.  
  78. com=setstack||epath'SerEMP -Getty -DEVICE 'device' -UNIT 'unit
  79. address COMMAND com
  80. Empire_exitcode=RC
  81. Call PutLog('SerEmp exited RC:'Empire_exitcode,10,10)
  82.  
  83. Call PutLog('Shutting down Empire',10,10)
  84. call send(cr||'Exiting Empire Server'||cr)
  85. com=setstack||epath"EmpSHUT"
  86. address COMMAND com
  87. Empire_exitcode=RC
  88. Call PutLog('EmpShut exited RC:'Empire_exitcode,10,10)
  89. exit 0
  90.  
  91. req:
  92.     call send(cr||' The following Amiga Empire files are available'||cr)
  93.     do i=1 to empfiles
  94.         call send(empdesc.i||cr)
  95.     end
  96.     call send(cr||'  Enter the number(s) of the file(s) you want, separated by a space or hit CR to abort'||cr||cr)
  97.     resp=prompt(240,'  Select: ')
  98.     if words(resp) ~= 0 then do
  99.         do i=1 to words(resp)
  100.             select=word(resp,i)
  101.             if datatype(select,'N') then do
  102.                 if exists(empfile.select) then call xfer(empfile.select,get_fn(empfile.select))
  103.                     else call send(cr||'Can not find 'empfile.select) 
  104.             end
  105.             else call send(cr||'Invalid selection:'select)
  106.         end 
  107.     end
  108. return 0
  109.  
  110. send:
  111.     'Print' quote||arg(1)||quote
  112.     'Send' quote||arg(1)||quote
  113. return
  114.  
  115. prompt:
  116.     call send(cr||arg(2))
  117. getstring:
  118.     'GetInbound E0 'arg(1)
  119.     'String $(event)'
  120.     if upper(RESULT) = 'CARRIER' then do
  121.         'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) Lost Carrier"'
  122.         call PutLog('Lost carrier',10,10)
  123.         call cleanup 
  124.         exit
  125.     end
  126.     if upper(RESULT) = 'LOGIN' then do
  127.         'String $(namebuf)'
  128.         x= upper(RESULT) 
  129.     end
  130.     else x=""
  131. return x
  132.  
  133. xfer:
  134.     fulname=arg(1)
  135.     filname=arg(2)
  136.      'Set protocol ZMODEM'
  137.      'XprSetup xprzedzap.library "TN,ON,B8,F0,E30,AN,DN,KN,SY,RN,M1024"'
  138.      'SetUpDate "CON:0/60/640/$($(line).w_offset)/$(protocol) Empire Server/AUTO/SCREEN$(pscreen)"'
  139.      'XprSend' fulname
  140.      'XprClose'
  141.      'SetUpDate NULL'
  142. return 0
  143.  
  144. get_fn:
  145.     if LastPos('/', arg(1)) ~= 0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
  146.         else if LastPos(':', arg(1)) ~= 0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
  147.             else return arg(1)
  148.  
  149. PutLog:  procedure expose log script
  150.     if arg(3) < GetClip('STATUSLEVEL') then say arg(1)
  151.     if arg(2) > GetClip('LOGLEVEL') then return 0
  152.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  153. return 0
  154.  
  155. addslash:
  156. curr = arg(1)
  157. select
  158.     when right(curr, 1) = ":" then nop
  159.     when right(curr, 1) = "/" then nop
  160.         otherwise curr = curr"/"
  161. end
  162. return curr
  163.  
  164. dequote:
  165. parse arg thing
  166. parse var thing '"' unq_thing '"'
  167. if unq_thing ~= "" then return unq_thing
  168. return thing
  169.  
  170. cleanup:
  171. return
  172. break_c:
  173. break_d:
  174.     PutLog('User abort',10,10)
  175.     call cleanup
  176.     exit 10
  177. novalue: 
  178.         call template_oops "Novalue" sigl
  179. syntax:
  180.         call template_oops "Syntax(RC=" || RC || ")" sigl
  181. failure:
  182.         call template_oops "Failure(RC=" || RC || ")" sigl
  183. ioerr:
  184.         call template_oops "IOErr" sigl 
  185. halt:
  186.         call template_oops "Halt" sigl 
  187. template_oops: 
  188.         parse arg what badline
  189.         PutLog('ERR:'what "Line:"badline,10,10)
  190.         PutLog('ERR:'strip(sourceline(badline)),10,10)
  191.         call cleanup
  192.         exit(40)
  193. /**/
  194.  
  195.